home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2005 October / PCWOCT05.iso / Software / FromTheMag / The GIMP 2.2.8 / gimp-2.2.8-i586-setup.exe / {app} / share / gimp / 2.0 / scripts / grid-system.scm < prev    next >
Encoding:
GIMP Script-Fu Script  |  2005-06-30  |  3.6 KB  |  99 lines
  1. ;;; grid-system.scm -*-scheme-*-
  2. ;;; Time-stamp: <1998/01/20 23:22:02 narazaki@InetQ.or.jp>
  3. ;;; This file is a part of:
  4. ;;;   The GIMP (Copyright (C) 1995-1997 Spencer Kimball and Peter Mattis)
  5. ;;; Author: Shuji Narazaki (narazaki@InetQ.or.jp)
  6. ;;; Version 0.6
  7.  
  8. ;;; Code:
  9. (if (not (symbol-bound? 'script-fu-grid-system-x-divides (the-environment)))
  10.     (define script-fu-grid-system-x-divides "'(1 g 1)"))
  11. (if (not (symbol-bound? 'script-fu-grid-system-y-divides (the-environment)))
  12.     (define script-fu-grid-system-y-divides "'(1 g 1)"))
  13.  
  14. (define (script-fu-grid-system img drw x-divides-orig y-divides-orig)
  15.   (define (update-segment! s x0 y0 x1 y1)
  16.     (aset s 0 x0)
  17.     (aset s 1 y0)
  18.     (aset s 2 x1)
  19.     (aset s 3 y1))
  20.   (define (map proc seq)
  21.     (if (null? seq)
  22.         '()
  23.         (cons (proc (car seq))
  24.               (map proc (cdr seq)))))
  25.   (define (convert-g l)
  26.     (cond ((null? l) '())
  27.       ((eq? (car l) 'g) (cons 1.618 (convert-g (cdr l))))
  28.       ((eq? (car l) '1/g) (cons 0.618 (convert-g (cdr l))))
  29.       ('else (cons (car l) (convert-g (cdr l))))))
  30.   (define (wrap-list l)
  31.     (define (wrap-object obj)
  32.       (cond ((number? obj) (string-append (number->string obj) " "))
  33.         ((eq? obj 'g) "g ")
  34.         (eq? obj '1/g) "1/g "))
  35.     (string-append "'("
  36.            (apply string-append (map wrap-object l))
  37.            ")"))
  38.   (let* ((drw-width (car (gimp-drawable-width drw)))
  39.      (drw-height (car (gimp-drawable-height drw)))
  40.      (drw-offset-x (nth 0 (gimp-drawable-offsets drw)))
  41.      (drw-offset-y (nth 1 (gimp-drawable-offsets drw)))
  42.      (grid-layer #f)
  43.      (segment (cons-array 4 'double))
  44.      (stepped-x 0)
  45.      (stepped-y 0)
  46.      (temp 0)
  47.      (total-step-x 0)
  48.      (total-step-y 0))
  49.     (set! x-divides (convert-g x-divides-orig))
  50.     (set! y-divides (convert-g y-divides-orig))
  51.     (set! total-step-x (apply + x-divides))
  52.     (set! total-step-y (apply + y-divides))
  53.  
  54.     (gimp-image-undo-group-start img)
  55.  
  56.     (set! grid-layer (car (gimp-layer-copy drw TRUE)))
  57.     (gimp-image-add-layer img grid-layer 0)
  58.     (gimp-edit-clear grid-layer)
  59.     (gimp-drawable-set-name grid-layer "Grid Layer")
  60.  
  61.     (while (not (null? (cdr x-divides)))
  62.       (set! stepped-x (+ stepped-x (car x-divides)))
  63.       (set! temp (* drw-width (/ stepped-x total-step-x)))
  64.       (set! x-divides (cdr x-divides))
  65.       (update-segment! segment
  66.                (+ drw-offset-x temp) drw-offset-y
  67.                (+ drw-offset-x temp) (+ drw-offset-y drw-height))
  68.       (gimp-pencil grid-layer 4 segment))
  69.  
  70.     (while (not (null? (cdr y-divides)))
  71.       (set! stepped-y (+ stepped-y (car y-divides)))
  72.       (set! temp (* drw-height (/ stepped-y total-step-y)))
  73.       (set! y-divides (cdr y-divides))
  74.       (update-segment! segment
  75.                drw-offset-x (+ drw-offset-y temp)
  76.                (+ drw-offset-x drw-width) (+ drw-offset-y temp))
  77.       (gimp-pencil grid-layer 4 segment))
  78.  
  79.     (gimp-image-undo-group-end img)
  80.  
  81.     (set! script-fu-grid-system-x-divides (wrap-list x-divides-orig))
  82.     (set! script-fu-grid-system-y-divides (wrap-list y-divides-orig))
  83.     (gimp-displays-flush)))
  84.  
  85. (script-fu-register "script-fu-grid-system"
  86.             _"_Grid..."
  87.             "Draw grid as specified by X-DIVIDES (list of propotions relative to the drawable) and Y-DIVIDES. The color and width of grid is detemined by the current settings of brush."
  88.             "Shuji Narazaki <narazaki@InetQ.or.jp>"
  89.             "Shuji Narazaki"
  90.             "1997"
  91.             "RGB*, INDEXED*, GRAY*"
  92.             SF-IMAGE     "Image to use"          0
  93.             SF-DRAWABLE  "Drawable to draw grid" 0
  94.             SF-VALUE    _"X divisions" script-fu-grid-system-x-divides
  95.             SF-VALUE    _"Y divisions" script-fu-grid-system-y-divides)
  96.  
  97. (script-fu-menu-register "script-fu-grid-system"
  98.              _"<Image>/Script-Fu/Render")
  99.